# Legacy Code
# x <- Sys.glob("../norm_dr_sd_min/data/coop_ratio/*.csv")
#
#
# for(i in x){
#
# tournament_type <- "hetero_dr_sd_min"
# seed <- str_remove(i,".*data_") %>%
# str_remove(".csv")
# save_name <- paste0("../norm_dr_sd_min/data/coop_ratio/data_", seed, ".csv")
#
# df <- read_csv(i) %>%
# mutate(tournament_type = "hetero_dr_sd_min")
#
# print(df)
# write_csv(df, paste0(save_name))
#
# }
#
# for(i in x){
#
# tournament_type <- str_remove(i, "../") %>%
# str_remove("/data/outliers/.*")
# seed <- str_remove(i, ".*outliers/") %>%
# str_remove("_outlier_counts.csv")
# save_name <- paste0("../", tournament_type, "/data/outliers/", seed, "_harmonized.csv")
#
# df <- read_csv(i) %>%
# select(S.D., Counts) %>%
# mutate(seed = seed,
# tournament_type = tournament_type)
# write_csv(df, paste0(save_name))
#
# }
# df_outliers_max <- do.call(rbind, lapply(Sys.glob("../*max/data/outliers/*harmonized.csv"), read_csv))
# df_outliers_min <- do.call(rbind, lapply(Sys.glob("../*min/data/outliers/*harmonized.csv"), read_csv))
# df_outliers_homo <- do.call(rbind, lapply(Sys.glob("../control_group/data/outliers/*_seed"), read_csv)) %>%
# mutate(tournament_type = "control_group")
# df_outliers <- df_outliers_max %>%
# rbind(df_outliers_homo) %>%
# rbind(df_outliers_min) %>%
# mutate(tournament_type = case_when(
# tournament_type == "pareto_m_min" ~ "pareto_m_max",
# tournament_type == "pareto_dr_min" ~ "pareto_dr_max",
# tournament_type == "pareto_mdr_min" ~ "pareto_mdr_max",
# tournament_type == "pareto_m_max" ~ "pareto_m_min",
# tournament_type == "pareto_dr_max" ~ "pareto_dr_min",
# tournament_type == "pareto_mdr_max" ~ "pareto_mdr_min",
# TRUE ~ as.character(tournament_type))
# )
# rm(df_outliers_max, df_outliers_homo, df_outliers_min)
# df_coop_homo <- do.call(rbind, lapply(Sys.glob("../control_group/data/coop_ratio/*.csv"), read_csv))
# df_coop_max <- do.call(rbind, lapply(Sys.glob("../*max/data/coop_ratio/*.csv"), read_csv))
# df_coop_min <- do.call(rbind, lapply(Sys.glob("../*min/data/coop_ratio/*.csv"), read_csv))
# df_coop <- df_coop_homo %>%
# rbind(df_coop_max) %>%
# rbind(df_coop_min) %>%
# mutate(tournament_type = case_when(
# tournament_type == "pareto_m_min" ~ "pareto_m_max",
# tournament_type == "pareto_dr_min" ~ "pareto_dr_max",
# tournament_type == "pareto_mdr_min" ~ "pareto_mdr_max",
# tournament_type == "pareto_m_max" ~ "pareto_m_min",
# tournament_type == "pareto_dr_max" ~ "pareto_dr_min",
# tournament_type == "pareto_mdr_max" ~ "pareto_mdr_min",
# TRUE ~ as.character(tournament_type))
# )
# rm(df_coop_homo,df_coop_max,df_coop_min)
Import data
df_coop <- read_csv("results/cooperation_ratio.csv")
df_outliers <- read_csv("results/outliers.csv")
Cooperation Ratio
Analysis of cooperation ratio
df_coop %>%
group_by(tournament_type) %>%
summarise(mean_coop = round(mean(coop_ratio),3),
sd_coop = round(sd(coop_ratio),3)) %>%
ungroup() %>%
arrange(desc(mean_coop)) %>%
select(`Tournament` = tournament_type, `average cooperation ratio` = mean_coop, `standard deviation` = sd_coop) %>%
kable(caption = "Tournament types arranged by mean of cooperation ratio") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tournament types arranged by mean of cooperation ratio
|
Tournament
|
average cooperation ratio
|
standard deviation
|
|
hetero_dr_sd_max
|
0.600
|
0.161
|
|
homogenous
|
0.589
|
0.154
|
|
pareto_m_min
|
0.589
|
0.157
|
|
hetero_m_sd_max
|
0.586
|
0.157
|
|
pareto_mdr_min
|
0.583
|
0.162
|
|
hetero_mdr_sd_max
|
0.582
|
0.166
|
|
hetero_m_sd_min
|
0.580
|
0.161
|
|
pareto_dr_min
|
0.580
|
0.154
|
|
hetero_dr_sd_min
|
0.579
|
0.161
|
|
hetero_mdr_sd_min
|
0.579
|
0.160
|
|
pareto_m_max
|
0.575
|
0.158
|
|
pareto_mdr_max
|
0.572
|
0.162
|
|
pareto_dr_max
|
0.571
|
0.164
|
df_coop %>%
group_by(tournament_type) %>%
summarise(mean_coop = round(mean(coop_ratio),3),
sd_coop = round(sd(coop_ratio),3)) %>%
ungroup() %>%
arrange(desc(sd_coop)) %>%
select(`Tournament` = tournament_type, `average cooperation ratio` = mean_coop, `standard deviation` = sd_coop) %>%
kable(caption = "Tournament types arranged by s.d. of cooperation ratio") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Tournament types arranged by s.d. of cooperation ratio
|
Tournament
|
average cooperation ratio
|
standard deviation
|
|
hetero_mdr_sd_max
|
0.582
|
0.166
|
|
pareto_dr_max
|
0.571
|
0.164
|
|
pareto_mdr_max
|
0.572
|
0.162
|
|
pareto_mdr_min
|
0.583
|
0.162
|
|
hetero_dr_sd_max
|
0.600
|
0.161
|
|
hetero_dr_sd_min
|
0.579
|
0.161
|
|
hetero_m_sd_min
|
0.580
|
0.161
|
|
hetero_mdr_sd_min
|
0.579
|
0.160
|
|
pareto_m_max
|
0.575
|
0.158
|
|
hetero_m_sd_max
|
0.586
|
0.157
|
|
pareto_m_min
|
0.589
|
0.157
|
|
homogenous
|
0.589
|
0.154
|
|
pareto_dr_min
|
0.580
|
0.154
|
df_coop %>%
group_by(tournament_type, seed) %>%
summarise(mean_coop = mean(coop_ratio),
sd_coop = sd(coop_ratio)) %>%
ggplot(aes(x = as.factor(seed), y = mean_coop)) +
geom_bar(stat="identity") +
geom_errorbar(aes(ymin = mean_coop-sd_coop, ymax = mean_coop + sd_coop), width = .7) +
facet_wrap(~tournament_type) +
coord_flip() +
scale_fill_grey(guide = F) +
labs(title = "Mean cooperation ratio and standard deviation per seed, facetted by tournament type",
y = "cooperatio ratio",
x = " ")

Comparing the control group with heterogenous groups__
df_coop %>%
ggplot(aes(round, coop_ratio, color = tournament_type)) +
geom_smooth(color = "black") +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F)

Stability
Comparison of All Groups
my_formula <- y ~ x
df_outliers %>%
ggplot() +
geom_point(aes(S.D., Counts, color = as.factor(seed))) +
geom_smooth(aes(S.D., Counts), color = "black") +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Smooth function applied to count of outliers on standard deviation",
x = "standard deviation",
y = "count of outliers")

df_outliers %>%
select(x = S.D., y = Counts, tournament_type, seed) %>%
ggplot(aes(x = x, y = y)) +
geom_point(aes(x, y, color = as.factor(seed))) +
geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
stat_poly_eq(formula = my_formula,
aes(label = paste(..eq.label.., sep = "~~~")),
parse = TRUE,
label.x = 2) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
x = "standard deviation",
y = "count of outliers")

df_outliers %>%
filter(S.D. <= 2) %>%
select(x = S.D., y = Counts, tournament_type, seed) %>%
ggplot(aes(x = x, y = y)) +
geom_point(aes(x, y, color = as.factor(seed))) +
geom_smooth(method = "lm", color = "black", se=FALSE, formula = my_formula) +
stat_poly_eq(formula = my_formula,
aes(label = paste(..eq.label.., sep = "~~~")),
parse = TRUE,
label.x = 2) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
subtitle = "Range of S.D. limited from 0 to 1.5",
x = "standard deviation",
y = "count of outliers")

df_outliers %>%
filter(S.D. <= 2) %>%
group_by(tournament_type) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Intercept)) %>%
select(`tournament type` = tournament_type, intercept = Intercept, slope = Slope, `r2` = R2) %>%
kable() %>%
kable_styling()
|
tournament type
|
intercept
|
slope
|
r2
|
|
pareto_dr_min
|
375.8412
|
-173.1779
|
0.9652927
|
|
control_group
|
366.5375
|
-166.9000
|
0.9490888
|
|
pareto_m_min
|
364.4471
|
-167.6676
|
0.9524959
|
|
norm_m_sd_max
|
363.3324
|
-169.1309
|
0.9643471
|
|
norm_mdr_sd_min
|
362.6412
|
-168.7279
|
0.9541591
|
|
pareto_m_max
|
354.8750
|
-164.2500
|
0.9712504
|
|
pareto_mdr_max
|
353.1904
|
-162.3074
|
0.9457772
|
|
pareto_dr_max
|
349.6566
|
-161.9103
|
0.9529084
|
|
pareto_mdr_min
|
345.8625
|
-158.9000
|
0.9481187
|
|
norm_dr_sd_max
|
343.8375
|
-157.2000
|
0.9508106
|
|
norm_dr_sd_min
|
342.9221
|
-155.1676
|
0.9504934
|
|
norm_m_sd_min
|
341.5154
|
-154.4324
|
0.9585277
|
|
norm_mdr_sd_max
|
336.2353
|
-152.0632
|
0.9655064
|
df_outliers %>%
filter(S.D. <= 2) %>%
group_by(tournament_type) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
arrange(desc(Slope)) %>%
select(`tournament type` = tournament_type, intercept = Intercept, slope = Slope, `r2` = R2) %>%
kable() %>%
kable_styling()
|
tournament type
|
intercept
|
slope
|
r2
|
|
norm_mdr_sd_max
|
336.2353
|
-152.0632
|
0.9655064
|
|
norm_m_sd_min
|
341.5154
|
-154.4324
|
0.9585277
|
|
norm_dr_sd_min
|
342.9221
|
-155.1676
|
0.9504934
|
|
norm_dr_sd_max
|
343.8375
|
-157.2000
|
0.9508106
|
|
pareto_mdr_min
|
345.8625
|
-158.9000
|
0.9481187
|
|
pareto_dr_max
|
349.6566
|
-161.9103
|
0.9529084
|
|
pareto_mdr_max
|
353.1904
|
-162.3074
|
0.9457772
|
|
pareto_m_max
|
354.8750
|
-164.2500
|
0.9712504
|
|
control_group
|
366.5375
|
-166.9000
|
0.9490888
|
|
pareto_m_min
|
364.4471
|
-167.6676
|
0.9524959
|
|
norm_mdr_sd_min
|
362.6412
|
-168.7279
|
0.9541591
|
|
norm_m_sd_max
|
363.3324
|
-169.1309
|
0.9643471
|
|
pareto_dr_min
|
375.8412
|
-173.1779
|
0.9652927
|
Determining slope and start of instability
df_slope_intercept <- df_outliers %>%
filter(S.D. <= 2) %>%
group_by(as.factor(tournament_type)) %>%
do({
mod = lm(Counts ~ S.D., data = .)
data.frame(Intercept = coef(mod)[1],
Slope = coef(mod)[2],
R2 = summary(mod)$r.squared)
}) %>%
mutate(Var = -Intercept/Slope) %>%
select(tournament_type = `as.factor(tournament_type)`, everything()) %>%
right_join(df_outliers)
df_slope_intercept %>%
mutate(Intercept = round(Intercept, 0),
Slope = round(Slope, 0),
Var = round(Var, 2)) %>%
mutate(Formula = str_c("alpha:", Intercept, "m:", Slope, "v:", Var, sep = " ")) %>%
ggplot() +
geom_point(aes(S.D., Counts, color = as.factor(seed))) +
geom_abline(aes(intercept = Intercept, slope = Slope)) +
geom_hline(yintercept = 0) +
geom_text(aes(2.2, 300, label = Formula), size = 2.5) +
facet_wrap(~tournament_type) +
scale_color_grey(guide = F) +
labs(title = "Linear function applied to count of outliers on standard deviation",
subtitle = "Slope calculated for S.D. < 2",
x = "standard deviation",
y = "count of outliers")
